perm filename BNFER[BNF,JRA] blob
sn#001939 filedate 1972-10-06 generic text, type T, neo UTF8
(SETQ IBASE (ADD1 7))
(DEFPROP BNFER
(NIL INBNF
RDBNF
OUTBNF
<RULES>
<RULE>
<RTLST>
<RTPT>
<LFPT>
<RPELEM>
<SEXPR>
<SEXPRLIST>
>RULES<
>RULE<
>RTLST<
>LFPT<
>RTPT<
>RPELEM<
>SEXPR<
>SEXPRLIST<)
VALUE)
(DEFPROP INBNF
(LAMBDA NIL
(PROG NIL
(COND
((NULL (RDBNF)) (INC NIL T)
(PRINC (QUOTE "
YOUR BNF LOSES AT (PAGE . LINE) = "))
(PRIN1 (PGLINE))
(RETURN NIL)))
(SETQ RULES (TOP))
(PRODUCE RULES)
(SETQ LANG (APPEND <LANG> >LANG<))
(RETURN (QUOTE OK))))
EXPR)
(DEFPROP RDBNF
(LAMBDA NIL (PROG (X) (START) (SCANSET) (INC T) (SETQ X (<RULES>)) (SCANRESET) (RETURN X)))
EXPR)
(DEFPROP OUTBNF
(LAMBDA NIL (PROG NIL (SETQ &&Z (FUNFLAT (OUTTST RULES (QUOTE >RULES<)))) (OTST 140)))
EXPR)
(DEFPROP <RULES>
(LAMBDA NIL
(NLRR (QUOTE RULES)
(FUNCTION
(LAMBDA NIL
(COND ((AND (SPWD END)) NIL) ((AND (<RULE>) (<RULES>)) (CONS (STK 1) (STK 0))) (*NIL*))))))
EXPR)
(DEFPROP <RULE>
(LAMBDA NIL
(NLRR (QUOTE RULE)
(FUNCTION (LAMBDA NIL (COND ((AND (<LFPT>) (<RTLST>)) (CONS (STK 1) (CONS (STK 0) NIL))) (*NIL*))))))
EXPR)
(DEFPROP <RTLST>
(LAMBDA NIL
(NLRR (QUOTE RTLST)
(FUNCTION
(LAMBDA NIL
(COND ((AND (CH :) (CH :) (CH =) (<RTPT>) (<SEXPR>) (<RTLST>))
(CONS (CONS (STK 2) (CONS (STK 1) NIL)) (STK 0)))
((AND) NIL)
(*NIL*))))))
EXPR)
(DEFPROP <RTPT>
(LAMBDA NIL
(NLRR (QUOTE RTPT)
(FUNCTION
(LAMBDA NIL
(COND ((AND (QCH =) (CH >)) NIL) ((AND (<RPELEM>) (<RTPT>)) (CONS (STK 1) (STK 0))) (*NIL*))))))
EXPR)
(DEFPROP <LFPT>
(LAMBDA NIL (NLRR (QUOTE LFPT) (FUNCTION (LAMBDA NIL (COND ((AND (CH <) (<ID>) (CH >)) (STK 1)) (*NIL*))))))
EXPR)
(DEFPROP <RPELEM>
(LAMBDA NIL
(NLRR (QUOTE RPELEM)
(FUNCTION
(LAMBDA NIL
(COND ((AND (CH <) (<ID>) (CH >)) (STK 1))
((AND (QCH ↓)) (CONS (QUOTE FORMAT) (CONS (QUOTE %DOWN) NIL)))
((AND (QCH →) (<NUMBER>))
(CONS (QUOTE FORMAT) (CONS (CONS (QUOTE %IN) (CONS (STK 0) NIL)) NIL)))
((AND (QCH →)) (CONS (QUOTE FORMAT) (CONS (CONS (QUOTE %IN) (CONS (QUOTE 0) NIL)) NIL)))
((AND (<ID>)) (CONS (QUOTE SPWD) (CONS (STK 0) NIL)))
((AND (QCH /") (<CHAR>)) (CONS (QUOTE QCH) (CONS (STK 0) NIL)))
((AND (<CHAR>)) (CONS (QUOTE CH) (CONS (STK 0) NIL)))
(*NIL*))))))
EXPR)
(DEFPROP <SEXPR>
(LAMBDA NIL
(NLRR (QUOTE SEXPR)
(FUNCTION
(LAMBDA NIL (COND ((AND (<ATOM>)) (STK 0)) ((AND (CH /() (<SEXPRLIST>) (CH /))) (STK 1)) (*NIL*))))))
EXPR)
(DEFPROP <SEXPRLIST>
(LAMBDA NIL
(NLRR (QUOTE SEXPRLIST)
(FUNCTION
(LAMBDA NIL
(COND ((AND (<SEXPR>) (<SEXPRLIST>)) (CONS (STK 1) (STK 0)))
((AND (CH /.) (<ATOM>)) (STK 0))
((AND) NIL)
(*NIL*))))))
EXPR)
(DEFPROP >RULES<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE NIL) (STK1)) (LIST (QUOTE (%IN 0)) (QUOTE END)))
((AND (MATCH (QUOTE (* . *))) (>RULE< 1) (>RULES< 0))
(LIST (STK1) (QUOTE (%IN 0)) (STK0))))))))
EXPR)
(DEFPROP >RULE<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL (COND ((AND (MATCH (QUOTE (* *))) (>LFPT< 1) (>RTLST< 0)) (LIST (STK1) (STK0))))))))
EXPR)
(DEFPROP >RTLST<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
((AND (MATCH (QUOTE ((* *) . *))) (>RTPT< 2) (>SEXPR< 1) (>RTLST< 0))
(LIST (QUOTE (%IN 10))
(QUOTE (:CH :))
(QUOTE (:CH :))
(QUOTE (:CH =))
(STK2)
(STK1)
(QUOTE (%IN 0))
(STK0))))))))
EXPR)
(DEFPROP >LFPT<
(LAMBDA(%N)
(OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>ID< 1) (LIST (QUOTE (:CH <)) (STK1) (QUOTE (:CH >)))))))))
EXPR)
(DEFPROP >RTPT<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE NIL) (STK1)) (LIST (QUOTE (%IN 60)) (QUOTE (:CH =)) (QUOTE (:CH >))))
((AND (MATCH (QUOTE (* . *))) (>RPELEM< 1) (>RTPT< 0)) (LIST (STK1) (STK0))))))))
EXPR)
(DEFPROP >RPELEM<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((AND (MATCH (QUOTE (FORMAT %DOWN)))) (QUOTE (:CH ↓)))
((AND (MATCH (QUOTE (FORMAT (%IN 0))))) (QUOTE (:CH →)))
((AND (MATCH (QUOTE (SPWD *))) (>ID< 0)) (STK0))
((AND (MATCH (QUOTE (QCH *))) (>CHAR< 0)) (LIST (QUOTE (:CH /")) (STK0)))
((AND (MATCH (QUOTE (CH *))) (>CHAR< 0)) (STK0))
((AND (MATCH (QUOTE (FORMAT (%IN *)))) (>NUMBER< 0)) (LIST (QUOTE (:CH →)) (STK0)))
((>ID< 1) (LIST (QUOTE (:CH <)) (STK1) (QUOTE (:CH >)))))))))
EXPR)
(DEFPROP >SEXPR<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((>ATOM< 1) (STK1))
((>SEXPRLIST< 1) (LIST (QUOTE (:CH /()) (QUOTE %DOWN) (STK1) (QUOTE (:CH /))))))))))
EXPR)
(DEFPROP >SEXPRLIST<
(LAMBDA(%N)
(OUTRUL %N
(FUNCTION
(LAMBDA NIL
(COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
((AND (MATCH (QUOTE (* . *))) (>SEXPR< 1) (>SEXPRLIST< 0))
(LIST (QUOTE (%IN 0)) (STK1) (STK0)))
((>ATOM< 1) (LIST (QUOTE (%IN 0)) (QUOTE (:CH /.)) (STK1))))))))
EXPR)